home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / icon / contrib / debug.lha / debug.icn < prev    next >
Text File  |  1991-12-29  |  15KB  |  470 lines
  1. ############################################################################
  2. #
  3. #   Name:   debug.icn
  4. #
  5. #   Title:  A DEBUGIFY-compatible debug procedure
  6. #
  7. #   Author: Charles A. Shartsis
  8. #
  9. #   Date:   December 29, 1991
  10. #
  11. ############################################################################
  12. #
  13. # See documentation in DEBUGIFY.DOC
  14. #
  15. ############################################################################
  16.  
  17. link strings
  18.  
  19. global __trace, __nodebug, __debug_in, __debug_out, __cmdlist, __trace_silent
  20.  
  21. procedure __debug_proc(file_name, proc_name, lineno, names, vals)
  22.  
  23.     static bp, default_io
  24.     local paramnum, varindex, curelt
  25.     
  26.     # First we do this:
  27.     initial {
  28.         
  29.         # Determine the initial trace mode
  30.         __trace := getenv("TRACEINIT")
  31.     
  32.         bp := table(&null)
  33.         default_io := table(&null)
  34.         default_io["UNIX"] := ["/dev/tty", "/dev/tty"]
  35.         default_io["MS-DOS"] := ["CON", "CON"]
  36.         
  37.         # Determine the input & output devices for debug
  38.         __debug_in := getenv("DEBUG_IN")
  39.         __debug_out := getenv("DEBUG_OUT")
  40.         if /__debug_in then 
  41.             if \default_io[&features] then
  42.                 __debug_in := default_io[&features][1]
  43.             else
  44.                 __debug_in := &input
  45.         if /__debug_out then 
  46.             if \default_io[&features] then
  47.                 __debug_out := default_io[&features][2]
  48.             else
  49.                 __debug_out := &output
  50.                 
  51.         # Open the I/O devices if they are strings rather than files
  52.         case type(__debug_in) of {
  53.         
  54.             "string": ( __debug_in := open(__debug_in,"r")) |
  55.                 stop(&errout, "Input debug device \"", __debug_in, "\" could not be opened")
  56.         
  57.             "file": 1
  58.         
  59.             default:
  60.                 stop(&errout, "The type of __debug_in is ", type(__debug_in),"\n",
  61.                     "It should be of type string or file")
  62.         
  63.         }
  64.         case type(__debug_out) of {
  65.         
  66.             "string": ( __debug_out := open(__debug_out,"w")) |
  67.                 stop(&errout, "Output debug device \"", __debug_out, "\" could not be opened")
  68.         
  69.             "file": {}
  70.         
  71.             default:
  72.                 stop(&errout, "The type of __debug_out is ", type(__debug_out),"\n",
  73.                     "It should be of type string or file")
  74.         
  75.         }
  76.     
  77.     }
  78.  
  79.     # Return if debug is suppressed
  80.     /__nodebug | return
  81.     
  82.     # If not in trace mode or
  83.     #   (trace is on and trace verbose is on) or
  84.     #   (trace is on and at a breakpoint)
  85.     # Print where we are
  86.     if /__trace | /__trace_silent | \bp[file_name || ": " || lineno] then {
  87.         __write_debug(
  88.             file_name || ":" || 
  89.             image(¤t) || ":" || 
  90.             proc_name || ":" || 
  91.             lineno
  92.         )
  93.     }
  94.         
  95.     # Not in trace mode or in trace mode and at a breakpoint
  96.     if not (\__trace & /bp[file_name || ": " || lineno]) then {
  97.     
  98.         # Read the first command
  99.         __read_cmd()
  100.         
  101.         # Process commands until no command entered
  102.         until *__cmdlist = 0 do {
  103.         
  104.             if *__cmdlist > 0 then {
  105.         
  106.                 case __cmdlist[1] of {
  107.             
  108.                 "p": {
  109.                 
  110.                     if *__cmdlist = 1 then {
  111.                         __write_debug("**** No variable names entered")
  112.                     }
  113.                     else {
  114.                     
  115.                         every paramnum := 2 to *__cmdlist do {
  116.                         
  117.                             if (varindex := __findvar(__cmdlist[paramnum], names)) = 0 then {
  118.                                 __write_debug("**** Variable \"" || __cmdlist[paramnum] || "\" does not exist")
  119.                             }
  120.                             else {
  121.                                 __write_debug(
  122.                                     names[varindex] || 
  123.                                     " TYPE: " || type(vals[varindex]) ||
  124.                                     " IMAGE: " || image(vals[varindex])
  125.                                 )
  126.                             }
  127.                         }
  128.                     }
  129.                     
  130.                     # Read the next command
  131.                     __read_cmd()
  132.                 }
  133.                 
  134.                 "pa": {
  135.                     if *__cmdlist > 1 then {
  136.                         __write_debug("**** No parameters allowed after \"pa\"")               
  137.                     }
  138.                     else {
  139.                     
  140.                         # print all variables
  141.                         every varindex := 1 to *names do {
  142.                             if type(vals[varindex]) ~== "procedure" then {
  143.                                 __write_debug(
  144.                                     names[varindex] || 
  145.                                     " TYPE: " || type(vals[varindex]) ||
  146.                                     " IMAGE: " || image(vals[varindex])
  147.                                 )
  148.                             }
  149.                         }
  150.                     }
  151.                    
  152.                     # Read the next command
  153.                     __read_cmd()
  154.                 }
  155.                 
  156.                 "sn":{
  157.                 
  158.                     if *__cmdlist ~= 3 then {
  159.                         __write_debug("**** \"sn\" requires exactly 2 paramaters")
  160.                     }
  161.                     else {
  162.                     
  163.                         if (varindex := __findvar(__cmdlist[2], names)) = 0 then {
  164.                             __write_debug("**** Variable \"" || __cmdlist[2] || "\" does not exist")
  165.                         }
  166.                         else {
  167.                             if not (vals[varindex] := numeric(__cmdlist[3])) then {
  168.                                 __write_debug("**** \"" || __cmdlist[3] || "\" is not numeric")
  169.                             }
  170.                         } 
  171.                     
  172.                     }
  173.                     
  174.                     # Read the next command
  175.                     __read_cmd()
  176.                 }
  177.                 
  178.                 "ss":{
  179.                
  180.                     if *__cmdlist < 3 then {
  181.                         __write_debug("**** \"ss\" requires 2 or more paramaters")
  182.                     }
  183.                     else {
  184.                     
  185.                         if (varindex := __findvar(__cmdlist[2], names)) = 0 then {
  186.                             __write_debug("**** Variable \"" || __cmdlist[2] || "\" does not exist")
  187.                         }
  188.                         else {
  189.                             
  190.                             tmpstring := __cmdlist[3]
  191.                             every paramnum := 4 to *__cmdlist do {
  192.                                 tmpstring ||:= " " || __cmdlist[paramnum]
  193.                             }
  194.                             vals[varindex] := replace(tmpstring, "\\ ", " ")
  195.                         } 
  196.                     
  197.                     }
  198.                     
  199.                     # Read the next command
  200.                     __read_cmd()
  201.                 }
  202.                 
  203.                 "sbp":{
  204.  
  205.                     if *__cmdlist = 1 then {
  206.                         __write_debug("**** No line numbers entered")
  207.                     }
  208.                     else {
  209.                     
  210.                         every paramnum := 2 to *__cmdlist do {
  211.                         
  212.                             if bpnum := integer(__cmdlist[paramnum]) then {
  213.                                 bp[file_name || ": " || bpnum] := 1
  214.                                 __write_debug(bpnum || ": breakpoint set")
  215.                             }
  216.                             else {
  217.                                 __write_debug("**** \"" || __cmdlist[paramnum] || "\" is not a valid line number")
  218.                             }
  219.                         }
  220.                     }
  221.                     
  222.                     # Read the next command
  223.                     __read_cmd()
  224.                 }
  225.                 
  226.                 "ubp":{
  227.                     if *__cmdlist = 1 then {
  228.                         __write_debug("**** No line numbers entered")
  229.                     }
  230.                     else {
  231.                     
  232.                         every paramnum := 2 to *__cmdlist do {
  233.                         
  234.                             if bpnum := integer(__cmdlist[paramnum]) then {
  235.                                 bp[file_name || ": " || bpnum] := &null
  236.                                 __write_debug(bpnum || ": breakpoint unset")
  237.                             }
  238.                             else {
  239.                                 __write_debug("**** \"" || __cmdlist[paramnum] || "\" is not a valid line number")
  240.                             }
  241.                         }
  242.                     }
  243.                        # Read the next command
  244.                     __read_cmd()
  245.                 }
  246.                 
  247.                 "pbp":{
  248.                     
  249.                     __write_debug("Breakpoints currently set:")
  250.                     every curelt := !sort(bp) do {
  251.                         if \curelt[2] then {
  252.                             __write_debug(curelt[1])
  253.                         }
  254.                     }
  255.                     
  256.                     # Read the next command
  257.                     __read_cmd()
  258.                     
  259.                 }
  260.                 
  261.                 "nd":{
  262.                 
  263.                     __nodebug := 1
  264.                     break
  265.                 }
  266.                 
  267.                 "t":{
  268.                 
  269.                     __trace := 1
  270.                     __write_debug("**** Trace is now on")
  271.                 
  272.                     # Read the next command
  273.                     __read_cmd()
  274.                 }
  275.                 
  276.                 "ts":{
  277.                 
  278.                     __trace_silent := 1
  279.                     __write_debug("**** Trace is now silent")
  280.                 
  281.                     # Read the next command
  282.                     __read_cmd()
  283.                 }
  284.                 
  285.                 "tv":{
  286.                     __trace_silent := &null
  287.                     __write_debug("**** Trace is now verbose")
  288.                 
  289.                     # Read the next command
  290.                     __read_cmd()
  291.                 }
  292.                               
  293.                 "ut":{
  294.                     __trace := &null
  295.                     __write_debug("**** Trace is now off")
  296.                 
  297.                     # Read the next command
  298.                     __read_cmd()
  299.                 }
  300.                               
  301.                 ("?" | "h" | "help"):{
  302.                 
  303.                     __write_help()
  304.                     
  305.                     # Read the next command
  306.                     __read_cmd()
  307.                 }
  308.                 
  309.                 "stop":{
  310.                     stop(__debug_out, "**** Program stopped in DEBUG")
  311.                 }
  312.                 
  313.                 default:{
  314.                 
  315.                     __write_debug("**** Invalid command entered")
  316.                 
  317.                 
  318.                     # Read the next command
  319.                     __read_cmd()
  320.                 
  321.                 }
  322.             
  323.                 }
  324.             }
  325.         
  326.         }
  327.         
  328.     
  329.     }
  330.  
  331.  
  332. end
  333.  
  334. procedure __read_cmd(noprompt)
  335.  
  336.     static ws, nonws
  337.     local cmdline
  338.     initial {
  339.         ws := ' \t'
  340.         nonws := &ascii -- ws
  341.     }
  342.     
  343.     # Print the prompt
  344.     if /noprompt then
  345.         writes(__debug_out, "debug> ") | 
  346.             stop(&errout, "Could not write to debug output device")
  347.  
  348.     # Read next command line
  349.     (cmdline := read(__debug_in)) |
  350.         stop(&errout, "Could not read from debug input device")
  351.     
  352.     # Extract tokens into list
  353.     __cmdlist := []
  354.     cmdline ? {
  355.     
  356.         tab(many(ws))
  357.         while not pos(0) do{
  358.         
  359.             put(__cmdlist, tab(many(nonws)))
  360.             tab(many(ws))
  361.         
  362.         }
  363.     
  364.     }
  365.  
  366. end
  367.  
  368. procedure __lcase(s)
  369.  
  370.     static lcase, ucase
  371.     
  372.     initial {
  373.     
  374.         lcase := string(&lcase)
  375.         ucase := string(&ucase)
  376.     
  377.     }
  378.     
  379.     return map(s, ucase, lcase)
  380.     
  381. end
  382.  
  383. procedure __write_debug(line)
  384.  
  385.     write(__debug_out, line) | stop(&errout, "Could not write to debug output device")
  386.  
  387. end
  388.  
  389. procedure __findvar(varname, names)
  390.  
  391.     local varindex
  392.     
  393.     every varindex := 1 to *names do {
  394.     
  395.         if varname == names[varindex] then return varindex
  396.     
  397.     }
  398.     
  399.     return 0
  400.  
  401. end
  402.  
  403. procedure __write_help()
  404.  
  405. __scroll(&null)
  406. __scroll("p var [var]...              Print the type and image of each variable")
  407. __scroll("                            specified")
  408. __scroll("")
  409. __scroll("pa                          Print the type and image of all variables")
  410. __scroll("")
  411. __scroll("sn var number               Set the value of the variable to the number")
  412. __scroll("")
  413. __scroll("ss var sring                Set the value of the variable to the string")
  414. __scroll("")
  415. __scroll("sbp integer [integer]...    Set each of the specified line numbers as")
  416. __scroll("                            trace breakpoints")
  417. __scroll("")
  418. __scroll("ubp integer [integer]...    Unset each of the specified trace breakpoints")
  419. __scroll("")
  420. __scroll("pbp                         Print the line numbers of all current")
  421. __scroll("                            breakpoints")
  422. __scroll("")
  423. __scroll("nd                          Exit DEBUG immediately and do not return to")
  424. __scroll("                            DEBUG later unless __nodebug has been set")
  425. __scroll("                            to &null by the program")
  426. __scroll("")
  427. __scroll("t                           Turn on trace mode")
  428. __scroll("")
  429. __scroll("ut                          Turn off trace mode")
  430. __scroll("")
  431. __scroll("ts                          Make trace run silently")
  432. __scroll("")
  433. __scroll("tv                          Make trace run verbosely (default)")
  434. __scroll("")
  435. __scroll("?, h, help                  Print a list of DEBUG interpreter commands")
  436. __scroll("")
  437. __scroll("stop                        Immediately exit DEBUG and the program")
  438. __scroll("")
  439. __scroll("blank or empty line         Return to the program.  If trace mode is")
  440. __scroll("                            on then DEBUG status information will")
  441. __scroll("                            print prior to the execution of each")
  442. __scroll("                            program line until a breakpoint is")
  443. __scroll("                            encountered.  Otherwise the DEBUG")
  444. __scroll("                            interpreter will be invoked prior to the")
  445. __scroll("                            execution of each program line.")
  446.  
  447. end
  448.  
  449. procedure __scroll(line)
  450.  
  451.     static count, max
  452.     
  453.     initial max := 22
  454.     
  455.     if /line then {
  456.         count := 0
  457.         return
  458.     }
  459.         
  460.     __write_debug(line)
  461.     count +:= 1
  462.             
  463.     # Pause for operator input
  464.     if count = max-2 then {
  465.         __write_debug("\nPRESS ENTER TO CONTINUE")
  466.         __read_cmd(1)
  467.     }
  468.         
  469. end
  470.